/*
 *	Plurals
 *
 *	Author:	S.C.Merrall
 *
 *	File:	mp_io.m
 *
 *	Contents:	print
 *			print_pair
 *			print_integer
 *			print_vector
 *			out_of_scratch_p
 *			scratch[]
 *			print_symbol
 *
 *	Description:	Output formats for basic lisp objects to print
 *			plurals out without transferring contents to the
 *			front end.
 *
 *	Change History:
 *
 *	Date   Name Comment
 *    -------- ---- -------
 *    16:04:91 SCM  Created
 *    22:04:91 SCM  Uses MasPar Plural Heap Objects instead of offsets
 *    24:04:91 SCM  Added print_pair
 *    14:06:91 SCM  print_lisp_object becomes print
 *    15:05:91 SCM  Added print_vector and out_of_scratch_p
 *    04:06:91 SCM  Size in heap_header is now in bytes, changed vectors
 *    29:01:92 SCM  Started putting in support for symbols
 */

#include <mpl.h>
#include <stdio.h>

#include "constant.h"

#include "mp_object.h"
#include "mp_debug_off.h"
#include "mp_gc.h"
#include "mp_utils.h"
#include "mp_type.h"
#include "mp_main.h"	/* THIS IS TEMPORARY */

typedef struct cons_cell_ {
  natural car;
  natural cdr;
} cons_cell;

#define MAX_DEC_PLACES 6
#define OUTPUT_SCRATCH_SIZE (2*SCRATCH_MEMORY_SIZE/3)

/*----------------------------------------------------------------------------*
 * Function   : out_of_scratch_p
 *
 * Parameters : plural int *scratch_used:	Ammount of scratch space used
 *						so far
 *
 * Description:    Tests to see if we have used up more than two thirds of the
 *		scratch space and if so prints some dots and returns TRUE
 *		otherwise just returns FALSE
 *
 * Result     : plural int:	TRUE/FALSE
 *---------------------------------------------------------------------------*/

#ifdef __STDC__

plural int out_of_scratch_p( plural int *scratch_used )

#else

plural int out_of_scratch_p( scratch_used )

plural int * scratch_used;

#endif

{
DBG_CALL("out_of_scratch_p");
DBG_ARGS(fprintf(dbg,"scratch_used=%04x",scratch_used));

  if (*scratch_used > OUTPUT_SCRATCH_SIZE) {

    scratch[(*scratch_used)++] = '.';
    scratch[(*scratch_used)++] = '.';
    scratch[(*scratch_used)++] = '.';

DBG_EXIT(fprintf(dbg,"TRUE"));
    return TRUE;
  }

DBG_EXIT(fprintf(dbg,"FALSE"));
  return FALSE;
}
	
/*----------------------------------------------------------------------------*
 * Function   : print_pair
 *
 * Parameters : plural char *plural data:	Where the cons cells are living
 *		plural int scratch_used:	Where to write to in scratch
 *
 * Description:    Writes usual representation of a cons cell to the indicated
 *		position in scratch
 *
 * Result     : plural int: New value of scratch_used
 *---------------------------------------------------------------------------*/

#ifdef __STDC__

plural int print_pair( plural char *plural data, plural int scratch_used )

#else

plural int print_pair( data, scratch_used )

plural char *plural data;
plural int scratch_used;

#endif

{
  plural cons_cell pair; 		/* The pairs to be printed */
  plural natural car, cdr;
  MP_PluralHeap MPPH_car;	/* MasPar Plural Heap objects, where */
  MP_PluralHeap MPPH_cdr;	/* the car and cdr heap space is     */

DBG_CALL("print_pair");
DBG_ARGS(fprintf(dbg,"data=????, scratch_used=????"));

  if (scratch_used > OUTPUT_SCRATCH_SIZE) {

    scratch[scratch_used++] = '.';
    scratch[scratch_used++] = '.';
    scratch[scratch_used++] = '.';

DBG_EXIT(fprintf(dbg,"Exceeded scratch space"));
    return scratch_used;
  }

  pair = *(plural cons_cell *plural) data;

  OA_to_offsets(MPPH_car) = &(pair.car);
  OA_to_offsets(MPPH_cdr) = &(pair.cdr);

  scratch_used = print(MPPH_car, scratch_used);

  if (OA_offsets(MPPH_cdr) != NIL) {

    scratch[scratch_used++] = ' ';

    if (OA_info(MPPH_cdr) == MP_CONS)
      scratch_used = print_pair( OA_data(MPPH_cdr), scratch_used );
    
    else {

      scratch[scratch_used++] = '.';
      scratch[scratch_used++] = ' ';

      scratch_used = print(MPPH_cdr, scratch_used);
    }
  }

/*  scratch[scratch_used++] = ')';
  scratch[scratch_used] = NULL; */

DBG_EXIT(fprintf(dbg,"scratch_used=????"));
  return scratch_used;
}

/*----------------------------------------------------------------------------*
 * Function   : print_vector
 *
 * Parameters : plural char *plural data:	Where the vectors are living
 *              plural int *plural length:      The lengths of the vectors
 *		plural int scratch_used:	Where to write to in scratch
 *
 * Description:    Writes a vector in the usual format to the indicated 
 *		posistion in scratch
 *
 * Result     : plural int:	New value of scratch_used
 *---------------------------------------------------------------------------*/

#ifdef __STDC__

plural int print_vector( plural char *plural data,
			 plural int length,
			 plural int scratch_used )

#else

plural int print_vector( data, length, scratch_used )

plural char *plural data;
plural int length;
plural int scratch_used;

#endif

{
  plural int i;
  plural natural *plural vector;	/* The vectors to be printed        */
  plural natural element;
  MP_PluralHeap MPPH_elt;	/* masPar Plural Heap object, where */
					/* the element heap space is	    */

DBG_CALL("print_vector");
DBG_ARGS(fprintf(dbg,"data=????, scratch_used=????"));

DEBUG(fprintf(dbg,"length: ");)
DEBUG(p_fprintf(dbg," %d",length);)
DEBUG(fprintf(dbg,"\n");)

  scratch[scratch_used++] = '#';
  scratch[scratch_used] = '(';

  vector = (plural natural *plural) data;

  for (i=0; i<length; ++i) {            /* Print Lisp Object in each element */

    ++scratch_used;

    if (out_of_scratch_p(&scratch_used)) {

DBG_EXIT(fprintf(dbg,"Exceeded scratch space"));
      return scratch_used;
    }

    element = vector[i];
    OA_to_offsets(MPPH_elt) = &element;
    scratch_used = print(MPPH_elt, scratch_used);
    scratch[scratch_used] = ' ';
  }
  
  scratch[scratch_used++] = ')';
  scratch[scratch_used] = NULL;

DBG_EXIT(fprintf(dbg,"scratch_used=????"));
  return scratch_used;
}
	

/*----------------------------------------------------------------------------*
 * Function   : print_integer
 *
 * Parameters : plural char *plural data:        Where the integers are living
 *              plural int scratch_used:         Where to write to in scratch
 *
 * Description:    writes decimal reprentation of numbers pointed to into
 *              given location in scartch memory
 *
 * Result     : plural int: new values of scratch_used
 *---------------------------------------------------------------------------*/

#ifdef __STDC__

plural int print_integer( plural char *plural data, plural int scratch_used )

#else

plural int print_integer( data, scratch_used )

plural char *plural data;
plural int scratch_used;

#endif

{
  plural int integer;        /* The integers to be printed     */
  plural int i;              /* power of 10 for finding digits */
  plural int digit;          /* individual digit of decimal    */
  plural int digits;         /* length of numbers              */

DBG_CALL("print_integer");
DBG_ARGS(fprintf(dbg,"data=????, scratch_used=????"));

  integer = *(plural int *plural) data;
  
  if (integer < 0) {

    scratch[scratch_used++] = '-';
    integer = -integer;
  }
  digits = 0;

  do {

    digit = integer%10;
    integer = integer/10;

    ++digits;
    scratch[SCRATCH_MEMORY_SIZE - digits] = '0' + digit;

  } while (integer > 0);

  pp_memcpy((plural char *plural) &scratch[scratch_used],
	    (plural char *plural) &scratch[SCRATCH_MEMORY_SIZE - digits],
	    digits );

  scratch_used = scratch_used + digits;
				   
  scratch[scratch_used] = NULL;

DBG_EXIT(fprintf(dbg,"????"));
  return scratch_used;
}

/*----------------------------------------------------------------------------*
 * Function   : print_float
 *
 * Parameters : plural char *plural data:	The floats to be printed
 *		plural int scratch_used:	Where in scartch space to
 *						print floats.
 *
 * Description:    Writes decimal representation of numbers into the
 *		scratch space at the position indicated.
 *
 * Result     : plural int:	New value of scratch_used
 *---------------------------------------------------------------------------*/

#ifdef __STDC__

plural int print_float( plural char *plural data, plural int scratch_used )

#else

plural int print_float( data, scratch_used )

plural char *plural data;
plural int scratch_used;

#endif  

{
  plural float real;
  plural float original = 0.0;
  plural float printed = 0.0;
  plural int scratch_start;
  plural int places = 0;
  plural int digit;
  plural int printed_point = FALSE;
  plural float power;

DBG_CALL("print_float");
DBG_ARGS(fprintf(dbg,"data=????, scratch_used=????"));

  if (out_of_scratch_p(&scratch_used)) {

DBG_EXIT(fprintf(dbg,"Exceeded scratch space"));
    return scratch_used;
  }

  real = *(plural float *plural) data;
  if (real < 0.0) {
    
    scratch[scratch_used++] = '-';
    real = -real;
  }
  original = real;

  /* find power of 10 greater than number */

  for (power = (plural float) 1.0; (10.0*power) <= real; power = power * 10.0);

  while ((places != MAX_DEC_PLACES) && 
	 ((printed != original) || (power > 0.1))) {

    digit = (plural int) (real / power);
    scratch[scratch_used++] = '0' + digit;
    real = real - (power * (plural float) digit );
    printed = printed + (power * (plural float) digit);
    power = power/10.0;

    if (power < 1.0) {

      ++places;

      if (!printed_point) {

	scratch[scratch_used++] = '.';
	printed_point = TRUE;
      }
    }
  }

  scratch[scratch_used] = NULL;
  
DBG_EXIT(fprintf(dbg,"????"));
  return scratch_used;
}


/*----------------------------------------------------------------------------*
 * Function   : print_symbol
 *
 * Parameters : plural char *plural data:	Where the symbols are living
 *		plural int scratch_used:	Where to write to in scratch
 *
 * Description: Writes (at the moment) an address style repesentation of
 *		a symbol, that is it prints it as it's front end address
 *
 * Result     : plural int:	new values of scratch
 *---------------------------------------------------------------------------*/

#ifdef __STDC__

plural int print_symbol( plural char *plural data, plural int scratch_used )

#else

plural int print_symbol( data, scratch_used )

plural char *plural data;
plural int scratch_used;

#endif

{
  plural int ids;        /* The ids of the symbols to be printed */
  int i;

DBG_CALL("print_symbols");
DBG_ARGS(fprintf(dbg,"data=????, scratch_used=????"));

  if (scratch_used > OUTPUT_SCRATCH_SIZE) {

    scratch[scratch_used++] = '.';
    scratch[scratch_used++] = '.';
    scratch[scratch_used++] = '.';

DBG_FAIL(fprintf(dbg,"Exceeded scratch space"));
    return scratch_used;
  }

/*   scratch[scratch_used++] = '#';
 *   scratch[scratch_used++] = '<';
 *   scratch[scratch_used++] = 'i';
 *   scratch[scratch_used++] = 'd';
 *   scratch[scratch_used++] = '=';
 *   scratch_used = print_integer( data, scratch_used );
 *   scratch[scratch_used++] = '>';
 *   scratch[scratch_used] = NULL;
 */

  scratch[scratch_used++] = 1;
  
  for (i=0; i<sizeof(int); i++) scratch[scratch_used++] = *(data + i);

  scratch[scratch_used] = NULL;

DBG_EXIT(fprintf(dbg,"????"));
  return scratch_used;
}


/*----------------------------------------------------------------------------*
 * Function   : print
 *
 * Parameters : MP_PluralHeap MPPH_to_print:	MasPar Plural Heap object for plural
 *					to be printed
 *              plural int scratch_used:Current positions in scratch
 *
 * Description: Big switch statement to print out all know lisp objects
 *              Those processors which have used two thirds of the scratch
 *              space print "..." and give up at this stage.
 *
 * Result     : int:    ammount of scratch space used
 *---------------------------------------------------------------------------*/

#ifdef __STDC__

plural int print( MP_PluralHeap MPPH_to_print, plural int scratch_used )

#else

plural int print( MPPH_to_print, scratch_used )

MP_PluralHeap MPPH_to_print;
plural int scratch_used;

#endif

{  
  plural int type;
  plural heap_header header;
  plural heap_header *plural to_header;
  plural natural offset;
DBG_CALL("print");
DBG_ARGS(fprintf(dbg,"MPPH_to_print=%04x, scratch_used=????",MPPH_to_print));

  if (scratch_used > OUTPUT_SCRATCH_SIZE) {
    scratch[scratch_used++] = '.';
    scratch[scratch_used++] = '.';
    scratch[scratch_used++] = '.';
  }

  else if (OA_offsets(MPPH_to_print) == NIL) {

    scratch[scratch_used++] = '(';
    scratch[scratch_used++] = ')';
    scratch[scratch_used] = NULL;

  }
  else if (OA_offsets(MPPH_to_print) == NOT_NIL) {

    scratch[scratch_used++] = 't';
    scratch[scratch_used] = NULL;

  }
  else {

    offset = *MPPH_to_print;
    type = HH_info(heap_memory[offset]);
    type = HH_info(heap_memory[*MPPH_to_print]);
    type = OA_info(MPPH_to_print);
		   
    
    switch (type) {

    case MP_SYMBOL:

      scratch_used = print_symbol(OA_data(MPPH_to_print), scratch_used);
      break;
    
    case INTEGER:

      scratch_used = print_integer(OA_data(MPPH_to_print), scratch_used);
      break;

    case MP_FLOAT:

      scratch_used = print_float(OA_data(MPPH_to_print), scratch_used);
      break;

    case 6:

      scratch_used = print_symbol(OA_data(MPPH_to_print), scratch_used);
      break;

    case MP_CONS:
      
      scratch[scratch_used++] = '(';
      scratch_used = print_pair(OA_data(MPPH_to_print), scratch_used);
      scratch[scratch_used++] = ')';
      scratch[scratch_used] = NULL;
      break;

    case MP_VECTOR:

      scratch_used = print_vector(OA_data(MPPH_to_print), 
				  MP_LENGTH(OA_space(MPPH_to_print)), 
				  scratch_used);
      break;

    default:

      scratch[scratch_used++] = '?';
      scratch[scratch_used++] = '?';
      scratch[scratch_used++] = '?';
      scratch[scratch_used] = NULL;

    }
  }



DBG_EXIT(fprintf(dbg,"SUCCESS: ????"));
  return scratch_used;
}

